home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / PICTURE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  3KB  |  135 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Formatted Input ('Picture') Demo Program     }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {   by Jason Sprenger and John Wong              }
  8. {************************************************}
  9.  
  10.  
  11. program PictureMan;
  12.  
  13. {$R Picture.RES}
  14.  
  15. uses WinProcs, WinTypes, Strings, WObjects, FormLine;
  16.  
  17. const
  18.   idFirst        = 105;
  19.   idLast         = 106;
  20.   idPhone        = 107;
  21.   idPhonePicture = 110;
  22.   cmPhoneNumber  = 203;
  23.   cmAbout        = 999;
  24.  
  25.   Size1    = 15;
  26.   Size2    = 20;
  27.  
  28.  
  29. type
  30.  
  31.   MainTransRec = record
  32.     First: array[0..14] of CHAR;
  33.     Last: array[0..14] of CHAR;
  34.     Phone: array[0..14] of CHAR;
  35.   end;
  36.  
  37.   PhonePic = array[0..19] of CHAR;
  38.  
  39. var
  40.   F: Text;
  41.   Check1: Boolean;
  42.  
  43. type
  44.   TMyApp = object(TApplication)
  45.     procedure InitMainWindow; virtual;
  46.   end;
  47.  
  48.   PMyDialog = ^TMyDialog;
  49.   TMyDialog = object(TDlgWindow)
  50.     Special: PFormEdit;
  51.     PictureStr: PChar;
  52.     TheRec: MainTransRec;
  53.     ThePhonePic: PhonePic;
  54.     constructor Init(AParent: PWindowsObject; AName: PCHAR);
  55.     destructor Done; virtual;
  56.     function GetClassName: PChar; virtual;
  57.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  58.     procedure PhoneNumberPicture(var Msg: TMessage);
  59.       virtual cm_First + cmPhoneNumber;
  60.     procedure About(var Msg: TMessage); virtual cm_First + cmAbout;
  61.   end;
  62.  
  63. procedure TMyApp.InitMainWindow;
  64. begin
  65.   MainWindow:= new(PMyDialog, init(nil,'MainDialog'));
  66. end;
  67.  
  68. constructor TMyDialog.Init(AParent: PWindowsObject; AName: PCHAR);
  69. var dummy : PWindowsObject;
  70. begin
  71.   TDlgWindow.Init(AParent, AName);
  72.   PictureStr:= StrNew('(###) ###-####');
  73.   dummy := new(PEdit, InitResource(@Self, idFirst, Size1));
  74.   dummy := new(PEdit, InitResource(@Self, idLast, Size1));
  75.   Special := new(PFormEdit, InitResource(@Self, idPhone, Size1, PictureStr));
  76.   fillchar(TheRec, sizeof(TheRec), #0);
  77.   TransferBuffer := @TheRec;
  78. end;
  79.  
  80.  
  81. destructor TMyDialog.Done;
  82. begin
  83.   TDlgWindow.Done;
  84.   StrDispose(PictureStr);
  85. end;
  86.  
  87.  
  88. function TMyDialog.GetClassName: PChar;
  89. begin
  90.   GetClassName := 'PictureDemo';
  91. end;
  92.  
  93.  
  94. procedure TMyDialog.GetWindowClass(var AWndClass: TWndClass);
  95. begin
  96.   TDlgWindow.GetWindowClass(AWndClass);
  97.   AWndClass.hIcon:=LoadIcon(hInstance, 'PictureIcon');
  98. end;
  99.  
  100.  
  101. procedure TMyDialog.PhoneNumberPicture(var Msg: TMessage);
  102. var
  103.   TheDialog: PDialog;
  104.   PtrEdit: PEdit;
  105. begin
  106.   TheDialog:= new(PDialog, init(nil, 'PhonePicture'));
  107.   if Check1 then
  108.     begin
  109.       StrCopy(ThePhonePic, '(###) ###-####');
  110.       Check1 := False;
  111.     end;
  112.   new(PtrEdit, InitResource(TheDialog, idPhonePicture, Size2));
  113.   TheDialog^.TransferBuffer := @ThePhonePic;
  114.   Application^.ExecDialog(TheDialog);
  115.  
  116.   Special^.ChangePicture(ThePhonePic);
  117. end;
  118.  
  119.  
  120. procedure TMyDialog.About(var Msg: TMessage);
  121. begin
  122.   Application^.ExecDialog(new(PDialog, Init(@Self, 'AboutBox')));
  123. end;
  124.  
  125.  
  126.  
  127. var
  128.   MyApp: TMyApp;
  129. begin
  130.   Check1:= True;                    { variable Check1 used to regulate the initialization }
  131.   MyApp.Init('Demo');               { of the transfer buffer a second time.               }
  132.   MyApp.Run;
  133.   MyApp.Done;
  134. end.
  135.